home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 November / Chip Kasım 2000.iso / prog / share / 11 / setup.exe / %MAINDIR% / DEMOS / CISERVER / CHAT / FrmChat.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-09-07  |  8.5 KB  |  271 lines
  1. VERSION 4.00
  2. Begin VB.Form frmClient 
  3.    Caption         =   "TCP/IP Chat Client"
  4.    ClientHeight    =   5295
  5.    ClientLeft      =   1005
  6.    ClientTop       =   1905
  7.    ClientWidth     =   9480
  8.    Height          =   5700
  9.    Left            =   945
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   5295
  12.    ScaleWidth      =   9480
  13.    Top             =   1560
  14.    Width           =   9600
  15.    Begin VB.Frame Frame1 
  16.       Height          =   1365
  17.       Left            =   0
  18.       TabIndex        =   2
  19.       Top             =   3930
  20.       Width           =   9465
  21.       Begin VB.TextBox txtMessage 
  22.          BeginProperty Font 
  23.             name            =   "Terminal"
  24.             charset         =   1
  25.             weight          =   700
  26.             size            =   9
  27.             underline       =   0   'False
  28.             italic          =   0   'False
  29.             strikethrough   =   0   'False
  30.          EndProperty
  31.          Height          =   915
  32.          Left            =   90
  33.          MaxLength       =   240
  34.          MultiLine       =   -1  'True
  35.          TabIndex        =   5
  36.          Top             =   360
  37.          Width           =   8025
  38.       End
  39.       Begin VB.CommandButton cmdSend 
  40.          Caption         =   "Send"
  41.          Default         =   -1  'True
  42.          Height          =   420
  43.          Left            =   8190
  44.          TabIndex        =   4
  45.          Top             =   360
  46.          Width           =   1185
  47.       End
  48.       Begin VB.CommandButton cmdExit 
  49.          Caption         =   "Exit"
  50.          Height          =   420
  51.          Left            =   8190
  52.          TabIndex        =   3
  53.          Top             =   855
  54.          Width           =   1185
  55.       End
  56.       Begin VB.Label Label2 
  57.          Caption         =   "Enter Message here:"
  58.          Height          =   285
  59.          Left            =   90
  60.          TabIndex        =   7
  61.          Top             =   135
  62.          Width           =   3885
  63.       End
  64.    End
  65.    Begin VB.ListBox lstNames 
  66.       Height          =   3570
  67.       ItemData        =   "FRMCHAT.frx":0000
  68.       Left            =   7530
  69.       List            =   "FRMCHAT.frx":0002
  70.       TabIndex        =   0
  71.       Top             =   360
  72.       Width           =   1920
  73.    End
  74.    Begin VB.Label Label1 
  75.       Caption         =   "Currently Chatting:"
  76.       Height          =   285
  77.       Left            =   7650
  78.       TabIndex        =   6
  79.       Top             =   90
  80.       Width           =   1905
  81.    End
  82.    Begin CITCPLib.CITCP tcpChat 
  83.       Height          =   450
  84.       Left            =   6930
  85.       Top             =   3420
  86.       Width           =   480
  87.       _version        =   65536
  88.       _extentx        =   847
  89.       _extenty        =   794
  90.       _stockprops     =   0
  91.       hostname        =   ""
  92.       hostaddress     =   ""
  93.       servicename     =   ""
  94.       port            =   2000
  95.    End
  96.    Begin PdqcommLib.PDQComm pdqTerm 
  97.       Height          =   3780
  98.       Left            =   0
  99.       TabIndex        =   1
  100.       Top             =   90
  101.       Width           =   7410
  102.       _version        =   196609
  103.       _extentx        =   13070
  104.       _extenty        =   6668
  105.       _stockprops     =   4
  106.       BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713} 
  107.          name            =   "Terminal"
  108.          charset         =   1
  109.          weight          =   400
  110.          size            =   9
  111.          underline       =   0   'False
  112.          italic          =   0   'False
  113.          strikethrough   =   0   'False
  114.       EndProperty
  115.       autosize        =   -1  'True
  116.       backcolor       =   8
  117.       columns         =   60
  118.       emulation       =   2
  119.       fastscroll      =   0   'False
  120.       forecolor       =   9
  121.       Object.height          =   252
  122.       rows            =   21
  123.       scrollrows      =   540
  124.       Object.width           =   480
  125.       appearance      =   1
  126.    End
  127. Attribute VB_Name = "frmClient"
  128. Attribute VB_Creatable = False
  129. Attribute VB_Exposed = False
  130. Dim Connect As Boolean
  131. Private Sub cmdExit_Click()
  132. ' Send an exit message to the screen and unload the file.
  133. tcpChat.Send "~|exit" & ScreenName
  134. Unload Me
  135. End Sub
  136. Private Sub cmdSend_Click()
  137. 'check if there is any text to send
  138. If txtMessage.Text = "" Then Exit Sub
  139. 'append screenname to message and send to TCP/IP server
  140. tcpChat.Send ScreenName & "> " & txtMessage.Text
  141. 'Clear textbox and setfocus back.
  142. txtMessage.Text = ""
  143. txtMessage.SetFocus
  144. End Sub
  145. Private Sub Form_Activate()
  146. txtMessage.SetFocus
  147. End Sub
  148. Private Sub Form_Load()
  149. Dim Result As Integer
  150. 'center form on screen
  151. Me.Top = Screen.Height / 2 - Me.Height / 2
  152. Me.Left = Screen.Width / 2 - Me.Width / 2
  153. 'display chat window
  154. Me.Show
  155. Screen.MousePointer = 11
  156. pdqTerm.Disp = "
  157. [1;32m" & "Attempting connection to host" & vbCrLf & "
  158. [1;34m"
  159. DoEvents
  160. 'set tcp/ip controls properties Port, Hostname or Address
  161. tcpChat.Port = PortNum
  162. If HostName <> "" Then
  163.     tcpChat.HostName = HostName
  164.     tcpChat.HostAddress = HostAddress
  165. End If
  166. 'attempt connection to CISERVER Host
  167. Result = tcpChat.ConnectToHost
  168. End Sub
  169. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  170. 'Close the Socket
  171. tcpChat.CloseSocket
  172. DoEvents
  173. End Sub
  174. Private Sub lstNames_DblClick()
  175. txtMessage.SetFocus
  176. End Sub
  177. Private Sub tcpChat_Connection(ByVal address As String)
  178. Connect = True
  179. 'send ScreenName to tcpserver
  180. tcpChat.Send "~|name=" & ScreenName
  181. 'dispay success message to terminal
  182. pdqTerm.Disp = "
  183. [1;32m" & "Host Contacted" & vbCrLf & vbCrLf & "
  184. [1;34m"
  185. Screen.MousePointer = 0
  186. End Sub
  187. Private Sub tcpChat_PacketReceived(Packet As Variant, ByVal bytes_in As Integer)
  188. Dim i As Integer
  189. Dim sent As Boolean
  190. Dim done As Boolean
  191. Dim message As String
  192. 'test if we have received a screenname and add to listbox
  193. If Left(Packet, 7) = "<Names>" Then
  194.     lstNames.Clear
  195.     message = Right(Packet, Len(Packet) - 7)
  196.     Do
  197.     i = InStr(message, Chr(13))
  198.     If i Then
  199.     lstNames.AddItem Left(message, i - 1) 'Add name to listbox
  200.     message = Right(message, Len(message) - i)
  201.     End If
  202.     Loop Until message = ""
  203.     ' test if server denied connection
  204.     If Packet = "Sorry, No more connections accepted at this time" Then
  205.     'Maximum number of connections reached
  206.         MsgBox "Sorry, the server is not accepting anymore connections", 0, "Unable to connect"
  207.         Unload Me
  208.         End
  209.     End If
  210.     ' display packet to terminal window
  211.     'first extract name and display in color
  212.     i = InStr(Packet, ">")
  213.     sname = Left(Packet, i)
  214.     i = Len(sname)
  215.     pdqTerm.Disp = "
  216. [1;36m" & sname & "
  217. [1;34m"
  218.     'break up remainder of message adding word wrap
  219.     'for terminal window display
  220.     message = Right(Packet, Len(Packet) - i)
  221.     Do
  222.         'Checking the character length breaks of characters of 60
  223.         If Len(message) <= 60 - i Then
  224.             pdqTerm.Disp = message
  225.             If Len(message) + i < 60 Then pdqTerm.Disp = vbCrLf
  226.             sent = True
  227.         Else
  228.             pos = 61 - i
  229.             Do
  230.                 If Mid(message, pos, 1) = " " Then
  231.                     pdqTerm.Disp = Left(message, pos - 1)
  232.                     If Len(Left(message, pos)) + i <= 60 Then pdqTerm.Disp = vbCrLf
  233.                     message = Right(message, Len(message) - pos)
  234.                     done = True
  235.                 Else
  236.                     pos = pos - 1
  237.                 End If
  238.             Loop Until done Or pos = 1
  239.             If pos = 1 Then
  240.                 pdqTerm.Disp = Left$(message, 60 - i)
  241.                 message = Right$(message, Len(message) - 60 + i)
  242.             End If
  243.             i = 0
  244.             pos = 60
  245.             done = False
  246.         End If
  247.     Loop Until sent
  248.     'Add carriage return/linefeed
  249.     pdqTerm.Disp = vbCrLf
  250. End If
  251. End Sub
  252. Private Sub tcpChat_WSAError(ByVal error_number As Integer)
  253. ' If Error is detected this event will fire and alert user
  254. ' to what the issue may be.
  255. If Not Connect Then
  256.     'If connection fails alert user
  257.         Screen.MousePointer = 0
  258.         pdqTerm.Disp = "
  259. [1;32m" & "Unable to establish connection to host" & vbCrLf & "WinSock Error #" & error_number & " occured. Error during connection" & "
  260. [1;34m"
  261.         MsgBox "Unable to connect to host", 0, "Connection Error"
  262.         Unload Me
  263.         frmSetup.Show
  264.         Exit Sub
  265. ' Display Winsock Error
  266.     pdqTerm.Disp = "
  267. [1;32m" & "WinSock Error #" & error_number & " occured" & "
  268. [1;34m" & vbCrLf & vbCrLf
  269. End If
  270. End Sub
  271.